home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Dylan alpha demos / Online Insultant src ƒ / Application.dylan next >
Encoding:
Text File  |  1994-12-13  |  2.0 KB  |  57 lines  |  [TEXT/ttxt]

  1. language: infix-dylan
  2. module: Online-Insultant
  3.  
  4. /* Copyright (C) 1994, Apple Computer, Inc. All rights reserved. */
  5.  
  6. /* This is the "main program" for the application
  7.    You can do main() in the Dylan Listener, or use
  8.    it as the startup function and Create Application
  9.  */
  10.  
  11. // Minimum heap size is 850K, at 800K it will run into the Toolbox bug
  12. // that _NewWindow calls _NewPtr without checking whether it failed!
  13. // More recently, I saw System Error 25 at 800K, might be the same bug
  14. // Of course it will run in less memory if you don't have the
  15. // Text to Speech system extension.
  16.  
  17. // For become-front-application
  18. define interface
  19.   #include "Events.h",
  20.      import: {"WaitNextEvent", "EventRecord"},
  21.      type: {"RgnHandle" => <machine-pointer>};
  22.   // Don't import slot accessors for EventRecord
  23.   struct "EventRecord", import: {};
  24. end interface;
  25.  
  26. // For become-front-application
  27. define interface
  28.   #include "Processes.h",
  29.      import: {"GetFrontProcess", "SetFrontProcess",
  30.               "ProcessSerialNumber", "GetCurrentProcess"};
  31. end interface;
  32.  
  33. define constant become-front-application = method()
  34.   with-stack-structure(this-process(<ProcessSerialNumber>),
  35.     begin
  36.       with-stack-structure(dummy-event(<EventRecord>),
  37.         begin
  38.           // Bring this process to the front so the user can see the window
  39.           GetCurrentProcess(this-process);
  40.           let err = SetFrontProcess(this-process);
  41.           if (err ~= 0) error("SetFrontProcess error %D", err); end if;
  42.           // SetFrontProcess doesn't work until the next WaitNextEvent
  43.           WaitNextEvent(0, dummy-event, 3, $null-machine-pointer);
  44.         end)
  45.     end)
  46. end method;
  47.  
  48. define constant main = method()
  49.   // When running tethered, bring the runtime application to the front
  50.   unless (*stand-alone-p*)
  51.     become-front-application();
  52.   end unless;
  53.   // Put up an insulting alert
  54.   offer-random-insult();
  55.   // next line should be redundant, actually, ExitToShell is supposed to do it
  56.   await-speech-done();
  57. end method;